unit uNeuralNetwork;

interface
uses
  Classes , uMatrix ;
type
  TNeuron = class
    Fu     : Double ;
    Fo     : Double ; 
  private
    function GetO : Double ;
    procedure SetFu(const Value: Double);
  public
    constructor Create;
    property u : Double read Fu write SetFu ;
    property o : Double read Fo write Fo ;
  end;

  TLayer = class
    FBias       : TMatrix;
    FWeights    : TMatrix;
    FNeurons    : array of TNeuron;
    FSize       : Integer;
    FDimension  : Integer;
    FOutput     : TMatrix;
  private
    procedure SetSize(const Value: Integer);
  public

    constructor Create (Dimension, Size : Integer);

    function OutputMatrix : TMatrix ;

    property Size : Integer read FSize write SetSize;

  end;

  TNeuralNetwork = class
  private
    FDimension : Integer;
    FLayer1,
    FLayer2   : TLayer;

    FError    : TMatrix;

    FAlpha1,
    FAlpha2   : TMatrix;

    FdW1,
    FdW2      : TMatrix;

    FVb1,
    FVb2,
    FVW1,
    FVW2      : TMatrix;

    FJ        : Double;
    FJHist    : TStringList ;
    FEta      : Double ;

    FMu       : Double;

    function GetResults : TMatrix ;
    function GetW1 : TMatrix ;
    function GetW2 : TMatrix ;
    function GetB1 : TMatrix ;
    function GetB2 : TMatrix ;
    function GetLayer1Size : Integer ;
    function GetLayer2Size : Integer ;
  public

    property WeightsLayer1 : TMatrix read GetW1 ;
    property WeightsLayer2 : TMatrix read GetW2 ;

    property BiasLayer1 : TMatrix read GetB1;
    property BiasLayer2 : TMatrix read GetB2;

    property SizeInput  : Integer read FDimension ;
    property SizeLayer1 : Integer read GetLayer1Size ;
    property SizeLayer2 : Integer read GetLayer2Size ;

    property Results : TMatrix read getResults ;

    property Eta  : Double read FEta write FEta;
    property Mu   : Double read FMu  write FMu;

    property J : Double read FJ;


    procedure CarregaBiasLayer1 ( Bias : String ) ;
    procedure CarregaBiasLayer2 ( Bias : String ) ;
    procedure CarregaWeightsLayer1 ( Weights : String ) ;
    procedure CarregaWeightsLayer2 ( Weights : String ) ;

    constructor Create(Dimension, NLayer1, NLayer2 : Integer; Eta : Double = 0.5; Mu : Double = 0);

    procedure FeedForward (X, Target : TMatrix);
    procedure BackPropagation (X : TMatrix);
    procedure Update;

    function Run (Iterations : Integer) : Double;

  end;


implementation
uses
  Math, SysUtils , Dialogs ;

{ TNeuron }

constructor TNeuron.Create;
begin
  //
end;

function TNeuron.GetO: Double;
begin

  result  := Tanh ( Fu ) ;
end;

procedure TNeuron.SetFu(const Value: Double);
begin
  Fu := Value;
end;

{ TLayer }

constructor TLayer.Create(Dimension, Size: Integer);
var
  i : Integer;
begin
  Randomize;
  FBias       := TMatrix.Create(Size, 1);
  FBias.RandomizeMatrix(0.0, 0.1);

  FWeights    := TMatrix.Create(Size, Dimension);
  FWeights.RandomizeMatrix(0.0, 0.1);

  SetLength(FNeurons, Size);

  for i := 0 to Size-1 do
    begin
      FNeurons[i] := TNeuron.Create;
    end;

  FSize := Size;
  FDimension := Dimension;

  FOutput := TMatrix.Create ( FSize , 1 ) ;

end;

function TLayer.OutputMatrix: TMatrix;
var
  i     : Integer ;
begin
  for i := 0 to FSize - 1 do
  begin
    FOutput[i,0] := FNeurons[i].Fo ;
  end;

  Result  := FOutput ;
end;

procedure TLayer.SetSize(const Value: Integer);
begin

end;


{ TNeuralNetwork }

procedure TNeuralNetwork.BackPropagation(X: TMatrix);
var
  M1, M2  : TMatrix;


  Alpha1, Alpha2  : TMatrix;

  tmpTranspose : TMatrix;
  tmpMultiply  : TMatrix;

  db2          : TMatrix ;
  dw2          : TMatrix ;

  db1          : TMatrix ;
  dw1          : TMatrix ;

begin

 try

  M2      := TMyMatrixOperations.CreateM ( FLayer2.OutputMatrix ) ;
  Alpha2  := TMyMatrixOperations.MultiplyMatrix ( M2 , FError ) ;
  FAlpha2.Sum  ( Alpha2 ) ;

  tmpTranspose  := TMyMatrixOperations.TransposeMatrix ( FLayer1.OutputMatrix ) ;
  dw2           := TMyMatrixOperations.KronMatrix ( tmpTranspose , Alpha2 ) ;
  FdW2.Sum ( dw2 );

  FreeAndNil ( M2 ) ;
  FreeAndNil ( tmpTranspose );
  FreeAndNil ( dw2 );

  // Limpar leak do outputmatrix
  M1      := TMyMatrixOperations.CreateM ( FLayer1.OutputMatrix ) ;
  tmpTranspose := TMyMatrixOperations.TransposeMatrix ( FLayer2.FWeights ) ;
  tmpMultiply  := TMyMatrixOperations.MultiplyMatrix ( M1 , tmpTranspose ) ;
  Alpha1  :=  TMyMatrixOperations.MultiplyMatrix ( tmpMultiply , Alpha2 )  ;
  FAlpha1.Sum (Alpha1 );

  FreeAndNil ( tmpTranspose );

  tmpTranspose  := TMyMatrixOperations.TransposeMatrix ( X ) ;
  dw1           := TMyMatrixOperations.KronMatrix ( tmpTranspose , Alpha1 ) ;
  FdW1.Sum ( dw1 );

  FreeAndNil ( M1 );
  FreeAndNil ( tmpTranspose ) ;
  FreeAndNil ( Alpha1 ) ;
  FreeAndNil ( dw1 ) ;
  FreeAndNil ( tmpMultiply );
  FreeAndNil ( Alpha2 ) ;

  except
    on E : Exception do
    begin
      ShowMessage (' Erro no BP  ' + E.message );
    end;

  end;






 {

  M2 := TMyMatrixOperations.CreateM(FLayer2.OutputMatrix);

  Alpha2 := TMyMatrixOperations.MultiplyMatrix(M2, FError);

  tmpTranspose := TMyMatrixOperations.TransposeMatrix(FLayer1.OutputMatrix);
  dW2    := TMyMatrixOperations.KronMatrix(tmpTranspose, Alpha2);
  FreeAndNil(tmpTranspose);

  M1 := TMyMatrixOperations.CreateM(FLayer1.OutputMatrix);

  tmpTranspose  := TMyMatrixOperations.TransposeMatrix(FLayer2.FWeights);
  tmpMultiply   := TMyMatrixOperations.MultiplyMatrix(M1, tmpTranspose);
  Alpha1 := TMyMatrixOperations.MultiplyMatrix(tmpMultiply, Alpha2);

  FreeAndNil(tmpTranspose);
  FreeAndNil(tmpMultiply);

  tmpTranspose  := TMyMatrixOperations.TransposeMatrix(X);

  dW1          := TMyMatrixOperations.KronMatrix(tmpTranspose, Alpha1);

  FreeAndNil(tmpTranspose);

  FdW1.Sum(dW1);
  FdW2.Sum(dW2);

  FAlpha1.Sum(Alpha1);
  FAlpha2.Sum(Alpha2);

  FreeAndNil(dW1);
  FreeAndNil(dW2);
  FreeAndNil(Alpha1);
  FreeAndNil(Alpha2);   }

  FreeAndNil(M2);
  FreeAndNil(M1);

end;

procedure TNeuralNetwork.CarregaBiasLayer1(Bias: String);
var
  i , j   : Integer ;
  List    : TStringList ;
  count   : integer;
begin

  List  := TStringList.Create ;

  List.Delimiter := ';' ;
  List.DelimitedText := Bias ;
  count := 0 ;
  for i := 0 to FLayer1.FBias.RowCount - 1 do
  begin
    for j := 0 to FLayer1.FBias.ColCount - 1 do
    begin
      FLayer1.FBias[i,j] := StrToFloat ( List [ count ] )  ;
      Inc(count);
    end;
  end;

  if Assigned ( List ) then
    FreeAndNil ( List ) ;

end;

procedure TNeuralNetwork.CarregaBiasLayer2(Bias: String);
var
  i , j   : Integer ;
  List    : TStringList ;
  count   : integer;
begin

  List  := TStringList.Create ;

  List.Delimiter := ';' ;
  List.DelimitedText := Bias ;
  count := 0 ;
  for i := 0 to FLayer2.FBias.RowCount - 1 do
  begin
    for j := 0 to FLayer2.FBias.ColCount - 1 do
    begin
      FLayer2.FBias[i,j] := StrToFloat ( List [ count ] )  ;
      Inc(count);
    end;
  end;

  if Assigned ( List ) then
    FreeAndNil ( List ) ;


end;

procedure TNeuralNetwork.CarregaWeightsLayer1(Weights: String);
var
  i , j   : Integer ;
  List    : TStringList ;
  count   : integer;
begin

  List  := TStringList.Create ;

  List.Delimiter := ';' ;
  List.DelimitedText := Weights ;
  count := 0 ;
  try
    for i := 0 to FLayer1.FWeights.RowCount - 1 do
    begin
      for j := 0 to FLayer1.FWeights.ColCount - 1 do
      begin
        FLayer1.FWeights[i,j] := StrToFloat ( List [ count ] )  ;
        Inc(count);
      end;
    end;
    if Assigned ( List ) then
      FreeAndNil ( List ) ;
  except
    on E : Exception do
    begin

    end;
  end;


end;

procedure TNeuralNetwork.CarregaWeightsLayer2(Weights: String);
var
  i , j   : Integer ;
  List    : TStringList ;
  count   : integer;
begin

  List  := TStringList.Create ;
  try
    List.Delimiter := ';' ;
    List.DelimitedText := Weights ;
    count := 0 ;
    for i := 0 to FLayer2.FWeights.RowCount - 1 do
    begin
      for j := 0 to FLayer2.FWeights.ColCount - 1 do
      begin
        FLayer2.FWeights[i,j] :=StrToFloat ( List [ count ] )  ;
        Inc(count);
      end;
    end;
    if Assigned ( List ) then
      FreeAndNil ( List ) ;
  except
    on E : Exception do
    begin

    end;
  end;




end;

constructor TNeuralNetwork.Create(Dimension, NLayer1, NLayer2: Integer; Eta : Double = 0.5; Mu : Double = 0);
begin
  FJ          := 0.0;

  FDimension  := Dimension ;

  FLayer1     := TLayer.Create ( FDimension , NLayer1 ) ;
  FLayer2     := TLayer.Create ( NLayer1 , NLayer2 );

  {FLayer1.FWeights[0,0] := -7.14 ;
  FLayer1.FWeights[1,0] := -5.65 ;
  FLayer1.FWeights[0,1] := -7.14 ;
  FLayer1.FWeights[1,1] := -5.65 ;

  FLayer1.FBias[0,0] := 3.04 ;
  FLayer1.FBias[1,0] := 8.44 ;


  FLayer2.FWeights[0,0] := -12;
  FLayer2.FWeights[0,1] := +12 ;

  FLayer2.FBias[0,0] := -5.95 ;   }

  FError      := TMatrix.Create ( NLayer2 , 1 );

  FdW1        := TMatrix.Create ( NLayer1, FDimension);
  FdW2        := TMatrix.Create ( NLayer2, NLayer1);

  FAlpha1     := TMatrix.Create ( NLayer1, 1);
  FAlpha2     := TMatrix.Create ( NLayer2, 1);

  FEta        := Eta;
  FMu         := Mu;

  FVb1        := TMatrix.Create( NLayer1, 1);
  FVb2        := TMatrix.Create( NLayer2, 1);

  FVW1        := TMatrix.Create( NLayer1, FDimension);
  FVW2        := TMatrix.Create( NLayer2, NLayer1);

  FJHist      := TStringList.Create ;

end;

procedure TNeuralNetwork.FeedForward(X, Target: TMatrix);
var
  i, j   : Integer ;
  tmp    : Double  ;
begin
try
  (* Feed-Forward Camada 1 *)
  for i := 0 to FLayer1.FSize - 1 do
  begin
    FLayer1.FNeurons[i].u := FLayer1.FBias[i, 0];
    for j := 0 to FLayer1.FDimension - 1 do
    begin
      FLayer1.FNeurons[i].u := FLayer1.FNeurons[i].u + ( X[j, 0] * FLayer1.FWeights [ i , j ] ) ;
    end;
    FLayer1.FNeurons[i].o   := Tanh ( FLayer1.FNeurons[i].u ) ;
  end;

  (* Feed-Forward Camada 2 *)
  for i := 0 to FLayer2.FSize - 1 do
  begin
    FLayer2.FNeurons[i].u := FLayer2.FBias[i, 0];
    for j := 0 to FLayer2.FDimension - 1 do
    begin
      FLayer2.FNeurons[i].u := FLayer2.FNeurons[i].u + ( FLayer1.FNeurons[j].o * FLayer2.FWeights [ i , j ] ) ;
    end;
    FLayer2.FNeurons[i].o   := Tanh ( FLayer2.FNeurons[i].u  ) ;
  end;

  tmp := 0;
  for i := 0 to FLayer2.Size-1 do
    begin
      FError[i, 0] := Target[i, 0] - FLayer2.FNeurons[i].o;
      tmp := tmp  + (FError[i, 0]*FError[i, 0]);
    end;
  FJ := ( tmp * 0.5 );


   except

    on E : Exception do
    begin
      ShowMessage (' Erro no FF  ' + E.message );
    end;

  end;

end;

function TNeuralNetwork.GetB1: TMatrix;
begin
  Result := FLayer1.FBias ;
end;

function TNeuralNetwork.GetB2: TMatrix;
begin
  Result := FLayer2.FBias ;
end;

function TNeuralNetwork.GetLayer1Size: Integer;
begin
  Result := FLayer1.FSize ;
end;

function TNeuralNetwork.GetLayer2Size: Integer;
begin
  Result := FLayer2.Size ;
end;

function TNeuralNetwork.GetResults: TMatrix;
begin
  Result := FLayer2.OutputMatrix ;
end;

function TNeuralNetwork.GetW1: TMatrix;
begin
  Result := FLayer1.FWeights ;
end;

function TNeuralNetwork.GetW2: TMatrix;
begin
  Result := FLayer2.FWeights ;
end;

function TNeuralNetwork.Run(Iterations: Integer): Double;
var
  i         : Integer ;
  Epocas    : Integer ;
  Fim       : Boolean ;
begin
  Result := 0.0;

  FJ     := 0 ;
  while not Fim do
  begin
    for i := 0 to Epocas - 1 do
    begin
      FeedForward ( TMatrix.Create , TMatrix.Create );
      BackPropagation ( TMatrix.Create );
    end;

    FJHist.Add ( FloatToStr ( FJ ) ) ;

    Update () ;

  end;
end;

procedure TNeuralNetwork.Update;
begin
try

  FAlpha1.Multiply(FEta);
  FVb1.Multiply(FMu);
  FVb1.Sum(FAlpha1);
  FLayer1.FBias.Sum(FVb1);

  FAlpha2.Multiply(FEta);
  FVb2.Multiply(FMu);
  FVb2.Sum(FAlpha2);
  FLayer2.FBias.Sum(FVb2);

  FdW1.Multiply(FEta);
  FVW1.Multiply(FMu);
  FVW1.Sum(FdW1);
  FLayer1.FWeights.Sum(FVW1);

  FdW2.Multiply(FEta);
  FVW2.Multiply(FMu);
  FVW2.Sum(FdW2);
  FLayer2.FWeights.Sum(FVW2);

  FAlpha1.Clear;
  FAlpha2.Clear;

  FdW1.Clear;
  FdW2.Clear;

  except

    on E : Exception do
    begin
      ShowMessage (' Erro no UP  ' + E.message );
    end;

  end;

end;

end.
 